home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr36 / lod370e.zip / PROGRAMR.ZIP / MESSAGES.PAS < prev    next >
Pascal/Delphi Source File  |  1993-02-12  |  9KB  |  407 lines
  1. unit messages;
  2. {$O+,F+,V-}
  3.  
  4. interface
  5. uses crt, globals, gtscott, ddlod, misc, messgio;
  6.  
  7. const
  8.  default_fore=lightcyan;
  9.  
  10. procedure EnterMessage(replyname,replysub: string);
  11. procedure NewMail;
  12. procedure ReadMail;
  13.  
  14. implementation
  15.  
  16. function msgok(attr: word; var mfrom,mto: string): boolean;
  17. begin;
  18.  if (attr and 1)<>1 then begin;
  19.   msgok:=true;
  20.   exit;
  21.  end;
  22.  msgok:=false;
  23.  if stu(user.alias)=stu(mfrom) then msgok:=true;
  24.  if stu(user.alias)=stu(mto) then msgok:=true;
  25. end;
  26.  
  27. procedure DispMessage(msgnum: word);
  28. var
  29.  mr: message_ptr;
  30.  b,c: integer;
  31.  quit,nonstop: boolean;
  32.  ch: char;
  33. begin;
  34.  new(mr);
  35.  Get_Message(msgnum,mr^);
  36.  sclrscr;
  37.  if not MsgOk(mr^.attribute,mr^.from,mr^.m_to) then begin;
  38.   outstr(2500);
  39.   dispose(mr);
  40.   exit;
  41.  end;
  42.  if (stu(mr^.from)='DELETED') or (stu(mr^.m_to)='DELETED') then begin;
  43.   outstr(2501);
  44.   dispose(mr);
  45.   exit;
  46.  end;
  47.  outstr(2502); swrite(va(msgnum));
  48.  while swherex<40 do swrite(' ');
  49.  outstr(2503); swriteln(mr^.datetime);
  50.  outstr(2504); swrite(mr^.from);
  51.  if (mr^.attribute and 1)<>0 then begin;
  52.   while swherex<40 do swrite(' ');
  53.   outstr(2507);
  54.  end else swriteln('');
  55.  outstr(2505); swriteln(mr^.m_to);
  56.  outstr(2506); swriteln(mr^.subject);
  57.  outstr(2509);
  58.  c:=5;
  59.  quit:=false;
  60.  nonstop:=false;
  61.  for b:=1 to mr^.lines do if (not quit) then begin;
  62.   inc(c);
  63.   swriteln(mr^.text[b]);
  64.   if (c=23) and (not quit) then begin;
  65.    getcnsprompt(ch);
  66.    if ch='S' then quit:=true;
  67.    if ch='N' then nonstop:=true;
  68.    c:=0;
  69.   end;
  70.  end;
  71.  set_foreground(default_fore);
  72.  dispose(mr);
  73. end;
  74.  
  75. procedure enter_wordwrap(var mr: message_Rec);
  76. var
  77.  s,s2: string[162];
  78.  a,b,c: integer;
  79.  ch: char;
  80.  done: boolean;
  81. begin;
  82.  done:=false;
  83.  a:=mr.lines+1;
  84.  mr.text[a]:='';
  85.  repeat;
  86.   set_foreground(default_fore);
  87.   s:=va(a)+':';
  88.   if length(s)=2 then s:=' '+s;
  89.   swrite(s);
  90.   set_foreground(15);
  91.   repeat;
  92.    sread_char(ch);
  93.    if (ch=#8) and (length(mr.text[a])>0) then begin;
  94.     swrite(#8+' '+#8);
  95.     delete(mr.text[a],length(mr.text[a]),1);
  96.    end;
  97.    if not (ch in [#$0d,#$08]) then begin;
  98.     mr.text[a]:=mr.text[a]+ch;
  99.     swrite(ch);
  100.    end;
  101.    if (ch=#$0d) and (length(mr.text[a])<>0) then mr.text[a]:=mr.text[a]+ch;
  102.    if length(mr.text[a])>72 then begin;
  103.     c:=0;
  104.     for b:=1 to length(mr.text[a]) do if mr.text[a][b]=' ' then c:=b;
  105.     s:='';
  106.     if c>60 then begin;
  107.      for b:=c+1 to length(mr.text[a]) do begin;
  108.       s:=s+mr.text[a][b];
  109.       swrite(#8+' '+#8);
  110.      end;
  111.      for b:=c to length(mr.text[a]) do delete(mr.text[a],length(mr.text[a]),1);
  112.     end;
  113.     a:=a+1;
  114.     swriteln('');
  115.     set_foreground(default_fore);
  116.     s2:=va(a)+':';
  117.     if length(s2)=2 then s2:=' '+s2;
  118.     swrite(s2);
  119.     set_foreground(15);
  120.     swrite(s);
  121.     mr.text[a]:=s;
  122.    end;
  123.   until ch=#13;
  124.   if length(mr.text[a])<>0 then begin;
  125.    swriteln('');
  126.    a:=a+1;
  127.    mr.text[a]:='';
  128.   end else done:=true;
  129.   if a=max_msg_lines then begin;
  130.    a:=a+1;
  131.    outstr(2510);
  132.    done:=true;
  133.   end;
  134.  until done;
  135.  mr.lines:=a-1;
  136.  swriteln('');
  137.  set_foreground(default_fore);
  138. end;
  139.  
  140. procedure EnterMessage(replyname,replysub: string);
  141. var
  142.  private: boolean;
  143.  fname: string;
  144.  mr: message_ptr;
  145.  s: string[128];
  146.  a,b: integer;
  147.  mnum: word;
  148. begin;
  149.  if maxavail<16384 then begin;
  150.   outstr(2511);
  151.   waitkey;
  152.   exit;
  153.  end;
  154.  new(mr);
  155.  sclrscr;
  156.  set_foreground(green);
  157.  outstr(2512);
  158.  swriteln(namestr(user.alias));
  159.  outstr(2513);
  160.  if replyname<>'' then begin;
  161.   mr^.m_to:=namestr(replyname);
  162.   swriteln(mr^.m_to);
  163.  end else begin;
  164.   prompt(mr^.m_to,30,false);
  165.   mr^.m_to:=namestr(mr^.m_to);
  166.  end;
  167.  outstr(2514);
  168.  if replysub<>'' then begin;
  169.   if pos('RE:',stu(replysub))=0 then mr^.subject:='Re: '+replysub else mr^.subject:=replysub;
  170.   swriteln(mr^.subject);
  171.  end else begin;
  172.   prompt(mr^.subject,50,false);
  173.  end;
  174.  mr^.datetime:=getfidodate;
  175.  outstr(2515);
  176.  swriteln(mr^.datetime);
  177.  private:=false;
  178.  outstr(2516);
  179.  sread(s);
  180.  swriteln('');
  181.  if length(s)>=1 then if (s[1]='Y') or (s[1]='y') then private:=true;
  182.  mr^.from:=namestr(user.alias);
  183.  mr^.attribute:=00;
  184.  if private then mr^.attribute:=mr^.attribute or 1;
  185.  mr^.replyto:=00;
  186.  mr^.nextreply:=00;
  187.  for a:=1 to max_msg_lines do mr^.text[a]:='';
  188.  outstr(2517);
  189.  mr^.lines:=0;
  190.  mnum:=find_highest_message+1;
  191.  enter_wordwrap(mr^);
  192.  repeat;
  193.   outstr(2518);
  194.   sread(s);
  195.   set_foreground(default_fore);
  196.   s:=stu(s);
  197.   if s='C' then if mr^.lines=175 then begin;
  198.    outstr(2519);
  199.   end else begin;
  200.    enter_wordwrap(mr^);
  201.   end;
  202.   if s='I' then begin;
  203.    if mr^.lines=0 then begin;
  204.     outstr(2520);
  205.    end else begin;
  206.     outstr(2521);
  207.     swrite(wva(mr^.lines));
  208.     outstr(2522);
  209.     sread_num(a);
  210.     if (a<1) or (a>mr^.lines) then begin;
  211.      outstr(2524);
  212.     end else begin;
  213.      outstr(2523);
  214.      swrite('>');
  215.      prompt(s,77,true);
  216.      for b:=mr^.lines downto a do mr^.text[b+1]:=mr^.text[b];
  217.      mr^.text[a]:=s;
  218.      mr^.lines:=mr^.lines+1;
  219.      s:='I';
  220.     end;
  221.    end;
  222.   end;
  223.   if s='D' then begin;
  224.    if mr^.lines=0 then begin;
  225.     outstr(2525);
  226.     swriteln('No lines in message to delete.');
  227.    end else begin;
  228.     outstr(2526);
  229.     swrite(wva(mr^.lines));
  230.     outstr(2527);
  231.     sread_num(a);
  232.     if (a<1) or (a>mr^.lines) then begin;
  233.      outstr(2524);
  234.     end else begin;
  235.      if a<>mr^.lines then for b:=a to mr^.lines-1 do mr^.text[b]:=mr^.text[b+1];
  236.      mr^.lines:=mr^.lines-1;
  237.     end;
  238.    end;
  239.   end;
  240.   if s='E' then begin;
  241.    if mr^.lines=0 then begin;
  242.     outstr(2528);
  243.    end else begin;
  244.     outstr(2529);
  245.     swrite(wva(mr^.lines));
  246.     outstr(2530);
  247.     sread_num(a);
  248.     if (a<1) or (a>mr^.lines) then begin;
  249.      outstr(2524);
  250.     end else begin;
  251.      outstr(2531);
  252.      swrite('>');
  253.      prompt(mr^.text[a],77,true);
  254.     end;
  255.    end;
  256.   end;
  257.   if s='L' then begin;
  258.    sclrscr;
  259.    for a:=1 to mr^.lines do begin;
  260.     s:=va(a)+':';
  261.     if length(s)=2 then s:=' '+s;
  262.     swrite(s);
  263.     set_foreground(15);
  264.     swriteln(mr^.text[a]);
  265.     set_foreground(default_fore);
  266.    end;
  267.   end;
  268.  until (s='S') or (s='A');
  269.  if s='S' then begin;
  270.   swriteln('Saving message....');
  271.   for a:=1 to mr^.lines-1 do begin;
  272.    if mr^.text[a][length(mr^.text[a])]<>#13 then mr^.text[a]:=mr^.text[a]+#13;
  273.   end;
  274.   add_message(mnum,mr^);
  275.  end else outstr(2532);
  276.  dispose(mr);
  277. end;
  278.  
  279. procedure NextMsg(var mnum: word);
  280. var
  281.  mr: message_ptr;
  282.  himsg: word;
  283. begin;
  284.  new(mr);
  285.  HiMsg:=Find_highest_message;
  286.  repeat;
  287.   inc(mnum);
  288.   if mnum<=himsg then Get_message_header(mnum,mr^);
  289.  until (msgok(mr^.attribute,mr^.from,mr^.m_to)) or (mnum>HiMsg);
  290.  if mnum>himsg then mnum:=himsg;
  291.  dispose(mr);
  292. end;
  293.  
  294. procedure PrevMsg(var mnum: word);
  295. var
  296.  mr: message_ptr;
  297. begin;
  298.  new(mr);
  299.  repeat;
  300.   dec(mnum);
  301.   if mnum>0 then Get_message_header(mnum,mr^);
  302.  until (msgok(mr^.attribute,mr^.from,mr^.m_to)) or (mnum=0);
  303.  if mnum=0 then mnum:=1;
  304.  dispose(mr);
  305. end;
  306.  
  307. procedure DoReply(mnum: word);
  308. var
  309.  mr: message_ptr;
  310.  fromname, fromsubj: string[80];
  311. begin;
  312.  new(mr);
  313.  Get_message_header(mnum,mr^);
  314.  fromname:=mr^.from;
  315.  fromsubj:=mr^.subject;
  316.  dispose(mr);
  317.  EnterMessage(fromname,fromsubj);
  318. end;
  319.  
  320. procedure NewMail;
  321. var
  322.  a,himsg,start: word;
  323.  mr: message_ptr;
  324.  b: boolean;
  325.  nummsg: word;
  326. begin;
  327.  if maxavail<16384 then begin;
  328.   outstr(2533);
  329.   waitkey;
  330.   exit;
  331.  end;
  332.  new(mr);
  333.  start:=user.lastread;
  334.  himsg:=Find_highest_message;
  335.  if start>himsg then start:=himsg;
  336.  start:=start+1;
  337.  nummsg:=0;
  338.  if (start<=himsg) or (himsg=0) then begin;
  339.   for a:=start to himsg do begin;
  340.    Get_message_header(a,mr^);
  341.    b:=false;
  342.    if (stu(mr^.m_to)=user.alias) or (stu(mr^.m_to)=user.realname) then b:=true;
  343.    if (mr^.attribute and 1)<>1 then b:=true;
  344.    if b then inc(nummsg);
  345.   end;
  346.  end;
  347.  if nummsg=0 then outstr(2534) else begin;
  348.   set_foreground(white);
  349.   swrite(wva(nummsg));
  350.   outstr(2547);
  351.  end;
  352.  dispose(mr);
  353. end;
  354.  
  355. procedure ReadMail;
  356. var
  357.  s: string[128];
  358.  mnum: word;
  359.  lastdir: char;
  360.  himsg: word;
  361.  a,b: integer;
  362. begin;
  363.  if maxavail<16384 then begin;
  364.   outstr(2535);
  365.   waitkey;
  366.   exit;
  367.  end;
  368.  set_Foreground(lightcyan);
  369.  swriteln('<Read Mail>');
  370.  set_foreground(default_fore);
  371.  mnum:=user.lastread;
  372.  himsg:=find_highest_message;
  373.  if himsg=0 then begin;
  374.   outstr(2536);
  375.   waitkey;
  376.   exit;
  377.  end;
  378.  if mnum>himsg then mnum:=himsg;
  379.  if mnum=0 then mnum:=1;
  380.  lastdir:='N';
  381.  repeat;
  382.   DispMessage(mnum);
  383.   outstr(2537);
  384.   swrite(wva(mnum));
  385.   outstr(2538);
  386.   swrite(wva(Find_highest_message));
  387.   outstr(2539);
  388.   sread(s);
  389.   s:=stu(s);
  390.   set_foreground(default_fore);
  391.   if s='' then if lastdir='N' then NextMsg(mnum) else PrevMsg(mnum);
  392.   val(s,a,b);
  393.   if (a>=1) and (a<=himsg) then mnum:=a;
  394.   if (s='N') then begin;
  395.    NextMsg(mnum);
  396.    lastdir:='N';
  397.   end;
  398.   if (s='P') then begin;
  399.    PrevMsg(mnum);
  400.    lastdir:='P';
  401.   end;
  402.   if (s='R') then DoReply(mnum);
  403.  until s='Q';
  404.  user.lastread:=mnum;
  405. end;
  406.  
  407. end.